VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDirSendFormC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit
Public CrystalConnectString As String
Dim cJMail As clsJMail
Public Sub SendFormC()
'******************************************************************************
'* Function  : SendFormC                                                      *
'* Copyright : Mindkey                                                        *
'* Author    : Maurice Milne                                                  *
'* Project   : Tax Directives System                                          *
'******************************************************************************
'* Description : function to retrieve then Tax Direcives received, format     *
'* them into valid PDF files and EMail them to the client.                    *
'******************************************************************************
'* Parameters :                                                               *
'******************************************************************************
'* Version 1.0 - 11/7/2000 M.Milne                                            *
'* Version 1.1 - 26/10/2000 M.Milne - Added Support Info to end of e-mail to  *
'*  client.  Upport message retrieved using SP dir_get_email_footnote         *
'******************************************************************************
'CHANGES                                                                      *
'******************************************************************************
'****       PERSON:     ANTHONY PATTON                                        *
'****       DATE:       19-08-2002                                            *
'****       PURPOSE:    KEYTAX WORKFLOW INTEGRATION                           *
'****************************************************************************
Dim sRequestBodyFile As String
Dim blCreateWorkItem As Boolean
Dim adoConn As ADODB.Connection
Dim adoComm As ADODB.Command
Dim adoIntComm As ADODB.Command

Dim adoRs As ADODB.Recordset
Dim adoRsParam As ADODB.Recordset
Dim adorsEMail As ADODB.Recordset
Dim adorsIT88 As ADODB.Recordset
Dim adorsSupportMsg As ADODB.Recordset 'Added 26/10/2000 to retrieve Support Message for EMail
Dim adoRSInterface As ADODB.Recordset

Dim sSupportMsg As String 'Added 26/10/2000 to hold Support Message for EMail
Dim sPDFPath As String
Dim lngRecordsAffected As Integer

Dim sErrMsg As String
Dim sEMailBody As String
Dim sFileName As String
Dim sIT88_Ref As String
Dim sConnStr As String
Dim sStage As String
Dim objReg As clsRegistry
Dim dTotalTax As Double
Dim iCounter As Integer
Dim adorsDeclineRsn As ADODB.Recordset 'Added 20/08/2000 to retrieve Decline Reasons for decline
Dim bFirstReason As Boolean 'Added 20/08/2000 to retrieve Decline Reasons for decline
Dim sfrequency As String
Dim sFormType As String
Dim objConn As clsConnect

'AP VARS
Dim rsDIR_INTERFACE_INDEX As ADODB.Recordset
Dim strSQL As String
Dim arrList() As String
Dim rsHolder As ADODB.Recordset
Dim lListCount As Long
Dim bOK As Integer
Dim sEmailWStnEmail As String
Dim sSendEmailToClient As String
Dim rsParams As ADODB.Recordset
Dim cmdKT As ADODB.Command
Dim strErrMsg As String

On Error GoTo Send_FormC_Error

'Check to see if this applications isn't already running. If so, exit function
Call IsAppRunning
If IsAppRunning = True Then
    Exit Sub
End If

Set rsParams = New ADODB.Recordset

'Set objReg = New clsRegistry
'sConnStr = Encrypt(objReg.AdoConnectString, "richardknowles")
'sConnStr = "Provider=SQLOLEDB.1;Data Source=lzg1504_01;User ID=sa;Password=mindkey;Initial Catalog=keytax_IS"
'sConnStr = "Provider=SQLOLEDB.1;Data Source=blueprnt-DEV2;User ID=sa; Password=blueprnt;Initial Catalog=keytax"
sConnStr = "Provider=SQLOLEDB.1;Data Source=SQL02;User ID=keytax; Password=m1ndk3y;Initial Catalog=keytax"
'sConnStr = "Provider=SQLOLEDB.1;Data Source=blueprnt_dev;User ID=keytax;Password=blueprnt;Initial Catalog=keytax"
'sConnStr = "Provider=SQLOLEDB.1;Data Source=blueprnt_sql;User ID=keytax;Password=mindkey;Initial Catalog=keytax"
'sConnStr = "Provider=SQLOLEDB;Driver={SQL Server};Server=SQLV02\I2;Initial Catalog=keytax;User ID=keytax; Password=k3ytax"

sStage = ""
'create connection to SQL Server
Set objConn = New clsConnect
Set adoConn = New ADODB.Connection
With adoConn
    .CursorLocation = adUseClient
    .IsolationLevel = adXactBrowse
    .ConnectionString = sConnStr
    .Open
End With

Set adoRs = New ADODB.Recordset
With adoRs
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
End With


Set adoComm = New ADODB.Command
With adoComm
    .CommandText = "DIR_directives_hardcopy_vw"
    .CommandType = adCmdTable
    Set .ActiveConnection = adoConn
End With
adoRs.Open "Dir_directives_hardcopy_vw", adoConn 'retrieve data


If adoRs Is Nothing Then
    MsgBox "No records found to email1.", vbInformation
    Exit Sub
Else
    If adoRs.EOF Then
        MsgBox "No records found to email2.", vbInformation
        Exit Sub
    End If
End If

'AP get the email workstations address from the params table
rsParams.Open "dir_get_param_values 'EMAIL_WSTN_ADDR'", adoConn
If rsParams.BOF = True And rsParams.EOF = True Then
    MsgBox "the EMAIL_WSTN_ADDR parameter has not been set up in DIR_PARAMETERS"
    Exit Sub
Else
    sEmailWStnEmail = rsParams!VAR_VALUE
End If
rsParams.Close

'AP get the param to send the second emai Y/N from dir_paramaters
rsParams.Open "dir_get_param_values 'EMAIL_SEND_YN'", adoConn
If rsParams.BOF = True And rsParams.EOF = True Then
    MsgBox "the EMAIL_SEND_YN parameter has not been set up in DIR_PARAMETERS"
    Exit Sub
Else
    sSendEmailToClient = rsParams!VAR_VALUE
End If

sStage = "Getting Parameters"
'Create Recordset to access all tax directives pending despatch to client
Set adoRsParam = New ADODB.Recordset
adoRsParam.Open "Dir_get_param_values 'EMAIL_HOME'", adoConn 'retrieve data
If adoRsParam.EOF Then 'no path defined - report error
  adoRsParam.Close
  SendErrorEmail adoRs.Fields("req_seq_num"), "Unable to access PDF path location - missing EMAIL_HOME parameter"
  'adoConn.Execute "dir_insert_error '" & Date & "','Unable to access PDF path location - missing EMAIL_HOME parameter','clsDirSendFormC',0"
  Set adoRsParam = Nothing
  Exit Sub
End If
'Shane: Only for the purpose of testing on LZG
'sPDFPath = adoRs.Fields("var_value").Value
sPDFPath = "C:\"
If Dir(sPDFPath & "*.pdf") <> "" Then
    Kill sPDFPath & "*.pdf"
End If

'*******************************************************************
'* Added 26/10/2000 - Access Support Clause to add to end of EMail *
'*******************************************************************
sStage = "Getting Email Footer"
Set adorsSupportMsg = New ADODB.Recordset
adorsSupportMsg.Open "dir_get_email_footnote", adoConn 'retrieve data
'no support message then ignore
If Not adorsSupportMsg.EOF Then
  sSupportMsg = adorsSupportMsg(0)
End If
adorsSupportMsg.Close
Set adorsSupportMsg = Nothing

Form2.Show

sStage = "Getting Directives Details"

Set adorsEMail = New ADODB.Recordset
Set adorsIT88 = New ADODB.Recordset
iCounter = 0
    

'Step through each retrieved response and process
'*******************************************************************
'BUILD THE EMAIL BODY AND ATTACHMENT
'*******************************************************************
While Not adoRs.EOF
    sStage = "Getting EMail Body"
    'Tina: for IRP3A's for Liberty - 2003-08-22
    If adoRs.Fields("scod_form_type") = "IRP3A" Then
        adorsEMail.Open "dir_get_email_body_irp3a " & adoRs.Fields("req_seq_num").Value, adoConn 'get Email body for Response
    Else
        adorsEMail.Open "dir_get_email_body " & adoRs.Fields("req_seq_num").Value, adoConn 'get Email body for Response
    End If
    sFileName = ""
    If Not adorsEMail.EOF Then
      sStage = "Checking EMail Body"
      If adorsEMail.Fields("create_pdf_yn") = "Y" Then 'process successful Request
        crFormC.RecordSelectionFormula = " {DIR_directives_hardcopy_vw.req_seq_num} = " & adoRs.Fields("req_seq_num").Value
        sStage = "Clearing Old Body " & adoRs.Fields("req_seq_num")
        crFormC.DiscardSavedData 'clear out old data
        crFormC.Database.AddADOCommand sConnStr, adoComm
        crFormC.Database.Verify
        sStage = "Getting Report Body " & adoRs.Fields("req_seq_num")
        crFormC.ReadRecords 'get data
        
        'Sort Fund Address and move Postal Code to last free address line
        'Tina: for IRP3A's... 26/08/2003
        If IsNull(adoRs.Fields("addr_l2")) = True Then
          crFormC.FormulaFields(19).Text = Chr(34) & adoRs.Fields("addr_l2") & Chr(34)
        Else
            crFormC.FormulaFields(19).Text = Chr(34) & Replace(Replace(adoRs.Fields("addr_l2"), "'", "''"), "", """") & Chr(34)
        End If
        If IsNull(adoRs.Fields("addr_l3")) = True Then
          crFormC.FormulaFields(20).Text = Chr(34) & adoRs.Fields("addr_l3") & Chr(34)
        Else
          crFormC.FormulaFields(20).Text = Chr(34) & Replace(Replace(adoRs.Fields("addr_l3"), "'", "''"), "", """") & Chr(34)
        End If
        If IsNull(adoRs.Fields("addr_l4")) = True Then
          crFormC.FormulaFields(21).Text = Chr(34) & adoRs.Fields("addr_l4") & Chr(34)
        Else
          crFormC.FormulaFields(21).Text = Chr(34) & Replace(Replace(adoRs.Fields("addr_l4"), "'", "''"), """", """""") & Chr(34)
        End If
        
        crFormC.FormulaFields(22).Text = Chr(34) & adoRs.Fields("Postal_Code") & Chr(34)
        If crFormC.FormulaFields(21).Text = Chr(34) & Chr(34) Then
          crFormC.FormulaFields(21).Text = crFormC.FormulaFields(22).Text
          crFormC.FormulaFields(22).Text = ""
          If crFormC.FormulaFields(20).Text = Chr(34) & Chr(34) Then
            crFormC.FormulaFields(20).Text = crFormC.FormulaFields(21).Text
            crFormC.FormulaFields(21).Text = ""
            If crFormC.FormulaFields(19).Text = Chr(34) & Chr(34) Then
              crFormC.FormulaFields(19).Text = crFormC.FormulaFields(20).Text
              crFormC.FormulaFields(20).Text = ""
            End If
          End If
        End If
        
        'Sort address and move Postal Code to last free address line
        crFormC.FormulaFields(15).Text = Chr(34) & Replace(Replace(adoRs.Fields("home_addr_l2"), "'", "''"), """", """""") & Chr(34)
        If IsNull(adoRs.Fields("home_addr_l3")) = True Then
          crFormC.FormulaFields(16).Text = Chr(34) & adoRs.Fields("home_addr_l3") & Chr(34)
        Else
          crFormC.FormulaFields(16).Text = Chr(34) & Replace(Replace(adoRs.Fields("home_addr_l3"), "'", "''"), """", """""") & Chr(34)
        End If
        If IsNull(adoRs.Fields("home_addr_l4")) = True Then
          crFormC.FormulaFields(17).Text = Chr(34) & adoRs.Fields("home_addr_l4") & Chr(34)
        Else
          crFormC.FormulaFields(17).Text = Chr(34) & Replace(Replace(adoRs.Fields("home_addr_l4"), "'", "''"), """", """""") & Chr(34)
        End If
        crFormC.FormulaFields(18).Text = Chr(34) & adoRs.Fields("home_Postal_Code") & Chr(34)
        If crFormC.FormulaFields(17).Text = Chr(34) & Chr(34) Then
          crFormC.FormulaFields(17).Text = crFormC.FormulaFields(18).Text
          crFormC.FormulaFields(18).Text = ""
          If crFormC.FormulaFields(16).Text = Chr(34) & Chr(34) Then
            crFormC.FormulaFields(16).Text = crFormC.FormulaFields(17).Text
            crFormC.FormulaFields(17).Text = ""
            If crFormC.FormulaFields(15).Text = Chr(34) & Chr(34) Then
              crFormC.FormulaFields(15).Text = crFormC.FormulaFields(16).Text
              crFormC.FormulaFields(16).Text = ""
            End If
          End If
        End If
        
        'Display only relevant text based on form type
        If adoRs.Fields("scod_form_type") = "FORM_AD" Then
          crFormC.Section8.Suppress = False
          crFormC.Section9.Suppress = True
          crFormC.Section10.Suppress = True
        ElseIf adoRs.Fields("scod_form_type") = "FORM_B" Then
          crFormC.Section8.Suppress = False
          crFormC.Section9.Suppress = True
          crFormC.Section10.Suppress = True
        ElseIf adoRs.Fields("scod_form_type") = "FORM_C" Then
          crFormC.Section8.Suppress = False
          crFormC.Section9.Suppress = True
          crFormC.Section10.Suppress = True
        ElseIf adoRs.Fields("scod_form_type") = "IRP3A" Then
          crFormC.Section8.Suppress = False
          crFormC.Section9.Suppress = True
          crFormC.Section10.Suppress = True
        ElseIf adoRs.Fields("scod_form_type") = "IRP3B" Then
          crFormC.Section8.Suppress = True
          crFormC.Section9.Suppress = False
          crFormC.Section10.Suppress = True
        ElseIf adoRs.Fields("scod_form_type") = "IRP3C" Then
          crFormC.Section8.Suppress = True
          crFormC.Section9.Suppress = True
          crFormC.Section10.Suppress = False
        End If
        
        'Display either fund details or employer details
        If adoRs.Fields("scod_form_type") = "FORM_AD" Or adoRs.Fields("scod_form_type") = "FORM_B" Or adoRs.Fields("scod_form_type") = "FORM_C" Then
          crFormC.Section5.Suppress = True
          crFormC.Section6.Suppress = False
          crFormC.Section11.Suppress = False
        ElseIf adoRs.Fields("scod_form_type") = "IRP3A" Or adoRs.Fields("scod_form_type") = "IRP3B" Or adoRs.Fields("scod_form_type") = "IRP3C" Then
          crFormC.Section5.Suppress = False
          crFormC.Section6.Suppress = True
          crFormC.Section11.Suppress = True
        End If
        
        crFormC.ExportOptions.DiskFileName = sPDFPath & adoRs.Fields("Directive_number") & ".PDF"
        crFormC.ExportOptions.FormatType = crEFTPortableDocFormat '(PDF)
        crFormC.ExportOptions.DestinationType = crEDTDiskFile
        sStage = "Checking for IT88 " & adoRs.Fields("req_seq_num")
        'sIT88_Ref = ""
        sIT88_Ref = adoRs.Fields("it88_ref_no")
        If Not IsNull(sIT88_Ref) Then
          sIT88_Ref = Trim(sIT88_Ref)
        End If
        If sIT88_Ref = "" Then 'no IT88 Form required
          sStage = "Hiding IT88 notification on directive page"
          crFormC.FormulaFields.Item(2).Text = ""
          sStage = "Hiding IT88 Page"
          crFormC.Section13.Suppress = True
        Else
          sStage = "Showing IT88 Page"
          crFormC.Section13.Suppress = False 'add IT88 onto Form C
          sStage = "Getting IT88 Details " & adoRs.Fields("req_seq_num")
          adorsIT88.Open "Dir_get_it88_detail " & adoRs.Fields("req_seq_num"), adoConn 'retrieve data
          If adorsIT88.EOF Then 'if IT88 details cannot be retrieved then report error
              SendErrorEmail adoRs.Fields("req_seq_num"), "Unable to access IT88 details for REQ_SEQ_NUM-" & adoRs.Fields("req_seq_num")
            'adoConn.Execute "dir_insert_error '" & Date & "','Unable to access IT88 details for REQ_SEQ_NUM-" & adoRs.Fields("req_seq_num") & "','clsDirSendFormC',0"
            adorsIT88.Close
            Set adorsIT88 = Nothing
            Set adoConn = Nothing
            Exit Sub
          End If
          sStage = "Inserting IT88 Details " & adoRs.Fields("req_seq_num")
          'Reset Tax Calculation table to default values
          crFormC.FormulaFields.Item(4).Text = Chr(34) & "N/A" & Chr(34)
          crFormC.FormulaFields.Item(5).Text = Chr(34) & "0.00" & Chr(34)
          crFormC.FormulaFields.Item(6).Text = Chr(34) & "0.00" & Chr(34)
          crFormC.FormulaFields.Item(7).Text = Chr(34) & "N/A" & Chr(34)
          crFormC.FormulaFields.Item(8).Text = Chr(34) & "N/A" & Chr(34)
          crFormC.FormulaFields.Item(10).Text = Chr(34) & "0.00" & Chr(34)
          crFormC.FormulaFields.Item(11).Text = Chr(34) & "0.00" & Chr(34)
          crFormC.FormulaFields.Item(12).Text = Chr(34) & "0.00" & Chr(34)
          crFormC.FormulaFields.Item(13).Text = Chr(34) & "0.00" & Chr(34)
          dTotalTax = 0
          'Move data from Recordset into Formulas on Report
          crFormC.FormulaFields.Item(2).Text = Chr(34) & adorsIT88.Fields("it88_ref_no").Value & Chr(34)
          crFormC.FormulaFields.Item(3).Text = Chr(34) & adorsIT88.Fields("stop_order_rsn").Value & Chr(34)
          If adorsIT88.Fields("vat_reg_no").Value <> "" Then crFormC.FormulaFields.Item(4).Text = Chr(34) & adorsIT88.Fields("vat_reg_no").Value & Chr(34)
           If adorsIT88.Fields("vat_amount").Value <> "" Then crFormC.FormulaFields.Item(5).Text = Chr(34) & Format(adorsIT88.Fields("vat_amount").Value, "#,##0.00") & Chr(34)
          dTotalTax = dTotalTax + IIf(IsNull(adorsIT88.Fields("vat_amount").Value), 0, adorsIT88.Fields("vat_amount").Value)
          If Not IsNull(adorsIT88.Fields("paye_amt").Value) Then crFormC.FormulaFields.Item(6).Text = Chr(34) & Format(adorsIT88.Fields("paye_amt").Value, "#,##0.00") & Chr(34)
          dTotalTax = dTotalTax + IIf(IsNull(adorsIT88.Fields("paye_amt").Value), 0, adorsIT88.Fields("paye_amt").Value)
          If Not IsNull(adorsIT88.Fields("per1").Value) Then crFormC.FormulaFields.Item(7).Text = Chr(34) & adorsIT88.Fields("per1").Value & Chr(34)
          If Not IsNull(adorsIT88.Fields("per2").Value) Then crFormC.FormulaFields.Item(8).Text = Chr(34) & adorsIT88.Fields("per2").Value & Chr(34)
          If Not IsNull(adorsIT88.Fields("per3").Value) Then crFormC.FormulaFields.Item(9).Text = Chr(34) & adorsIT88.Fields("per3").Value & Chr(34)
          If Not IsNull(adorsIT88.Fields("amt1").Value) Then crFormC.FormulaFields.Item(10).Text = Chr(34) & Format(adorsIT88.Fields("amt1").Value, "#,##0.00") & Chr(34)
          dTotalTax = dTotalTax + IIf(IsNull(adorsIT88.Fields("amt1").Value), 0, adorsIT88.Fields("amt1").Value)
          If Not IsNull(adorsIT88.Fields("amt2").Value) Then crFormC.FormulaFields.Item(11).Text = Chr(34) & Format(adorsIT88.Fields("amt2").Value, "#,##0.00") & Chr(34)
          dTotalTax = dTotalTax + IIf(IsNull(adorsIT88.Fields("amt2").Value), 0, adorsIT88.Fields("amt2").Value)
          If Not IsNull(adorsIT88.Fields("amt3").Value) Then crFormC.FormulaFields.Item(12).Text = Chr(34) & Format(adorsIT88.Fields("amt3").Value, "#,##0.00") & Chr(34)
          dTotalTax = dTotalTax + IIf(IsNull(adorsIT88.Fields("amt3").Value), 0, adorsIT88.Fields("amt3").Value)
          If Not IsNull(adorsIT88.Fields("assessed_tax_amt").Value) Then crFormC.FormulaFields.Item(13).Text = Chr(34) & Format(adorsIT88.Fields("assessed_tax_amt").Value, "#,##0.00") & Chr(34)
          dTotalTax = dTotalTax + IIf(IsNull(adorsIT88.Fields("assessed_tax_amt").Value), 0, adorsIT88.Fields("assessed_tax_amt").Value)
          crFormC.FormulaFields.Item(14).Text = Chr(34) & Format(dTotalTax, "#,##0.00") & Chr(34)
          adorsIT88.Close
        End If
        sStage = "Exporting FormC Data " & adoRs.Fields("req_seq_num")
        crFormC.Export (False) 'data to disk
        sFileName = sPDFPath & adoRs.Fields("directive_number") & ".pdf" 'attach PDF file
         'sFileName = "C:\Program Files\Adobe\Acrobat 4.0\Reader\ReadMe.pdf"
      End If
      
      sStage = "Creating EMail"
        'Build EMail Body
        sEMailBody = "SARS Application No : " & vbTab & adorsEMail.Fields("SARS_appl_id") & vbCrLf
        sEMailBody = sEMailBody & "KeyTax request number : " & vbTab & adorsEMail.Fields("req_seq_num") & vbCrLf
        'Tina: for IRP3A's... 26/08/2003
        If adoRs.Fields("scod_form_type") <> "IRP3A" Then
            sEMailBody = sEMailBody & "Fund : " & vbTab & vbTab & vbTab & vbTab & adorsEMail.Fields("Fund") & vbCrLf
            sEMailBody = sEMailBody & "Contract number : " & vbTab & vbTab & adorsEMail.Fields("Contract_number") & vbCrLf
        End If
        sEMailBody = sEMailBody & "Tax Payer : " & vbTab & vbTab & vbTab & adorsEMail.Fields("Taxpayer") & vbCrLf
        sEMailBody = sEMailBody & "Directive number : " & vbTab & vbTab & adorsEMail.Fields("directive_number") & vbCrLf
        sEMailBody = sEMailBody & "Requested date : " & vbTab & vbTab & Format(adorsEMail.Fields("request_date"), "DD/MM/YYYY") & vbCrLf
        sEMailBody = sEMailBody & "Requested by : " & vbTab & vbTab & vbTab & adorsEMail.Fields("requested_by") & vbCrLf
        sEMailBody = sEMailBody & "Request status : " & vbTab & vbTab & adorsEMail.Fields("request_status") & vbCrLf & vbCrLf
        If (UCase(adorsEMail.Fields("request_status")) = "APPLICATION DECLINED") Or _
           (UCase(adorsEMail.Fields("request_status")) = "DIRECTIVE DECLINED") Then
            'Fetch all the reasons
            sStage = "Getting Decline Reasons"
            Set adorsDeclineRsn = New ADODB.Recordset
            bFirstReason = True
            adorsDeclineRsn.Open "select * from dir_decline_reasons where req_seq_num =" & adorsEMail.Fields("req_seq_num"), adoConn 'retrieve data
            'no support message then ignore
            While Not adorsDeclineRsn.EOF
                If bFirstReason Then
                    If adorsDeclineRsn.Fields("decline_reason_code") = "05807" Then
                        sEMailBody = sEMailBody & "Decline Reason(s) : " & vbTab & vbTab & adorsDeclineRsn.Fields("decline_reason_code") & ": Refer to your local Receiver of Revenue office." & vbCrLf
                    Else
                        sEMailBody = sEMailBody & "Decline Reason(s) : " & vbTab & vbTab & adorsDeclineRsn.Fields("decline_reason_code") & ": " & adorsDeclineRsn.Fields("decline_reason_text") & vbCrLf
                    End If
                    bFirstReason = False
                Else
                    If adorsDeclineRsn.Fields("decline_reason_code") = "05807" Then
                        sEMailBody = sEMailBody & vbTab & vbTab & vbTab & vbTab & adorsDeclineRsn.Fields("decline_reason_code") & ": Refer to your local Receiver of Revenue office." & vbCrLf
                    Else
                        sEMailBody = sEMailBody & vbTab & vbTab & vbTab & vbTab & adorsDeclineRsn.Fields("decline_reason_code") & ": " & adorsDeclineRsn.Fields("decline_reason_text") & vbCrLf
                    End If
                End If
                adorsDeclineRsn.MoveNext
            Wend
            adorsDeclineRsn.Close
            Set adorsDeclineRsn = Nothing
        End If
        sEMailBody = sEMailBody & vbCrLf & sSupportMsg 'added 26/10/2000  - add support msg to end of e-mail
        sStage = "Submitting EMail " ' & adoRs.Fields("EMail_address")
    Else 'if EMail body missing
          SendErrorEmail adoRs.Fields("req_seq_num"), "No EMail Body Located for ID: " & adoRs.Fields("req_seq_num")
    End If
    
    'Dim sErrMsg As String
    
    '************************************************************************
    '****       AUTHOR:     ANTHONY PATTON
    '****       DATE:       19-08-2002
    '****       FUNCTION:   KeyTax Workflow Integration.
    '****       COMMENTS:   This code will check if the current response
    '****                   is for an automated request, if it is a second
    '****                   email will be sent to an Email Workstation address
    '****                   for autologger commital to the workflow.
    '************************************************************************
    
    sStage = "Submitting Email 2"
    
    Set cJMail = Nothing 'clear the old msg out
    Set cJMail = New clsJMail 'set up for new msg
    'look up in the DIR_INTERFACE_INDEX (is this a response to an auto request)
    strSQL = "select count(*) from DIR_INTERFACE_INDEX where REQ_SEQ_NUM=" & adoRs.Fields("req_seq_num")
    Set rsDIR_INTERFACE_INDEX = adoConn.Execute(strSQL)

    If rsDIR_INTERFACE_INDEX.Fields(0).Value > 0 Then
        Set rsHolder = New ADODB.Recordset
        'the current response has an auto request record
        rsHolder.Open "dir_get_param_values 'INCLUDE_IN_EMAIL'", adoConn

        If rsHolder.BOF = True And rsHolder.EOF = True Then
            MsgBox "The INCLUDE_IN_EMAIL parameter has not been set up in the dir_parameters table."
        End If
        
        arrList = Split(rsHolder!VAR_VALUE, ",")
        bOK = 0
        
        sStage = rsHolder!VAR_VALUE
        
        If UBound(arrList) > 0 Then
            For lListCount = 0 To UBound(arrList) - 1
                strSQL = "select scod_dir_req_rsn from dir_request where req_seq_num = " & adoRs.Fields("req_seq_num")
                Set rsHolder = adoConn.Execute(strSQL)
                If arrList(lListCount) = rsHolder.Fields("scod_dir_req_rsn") Then
                    bOK = 1
                    Exit For
                End If
            Next
        Else
            MsgBox "the INCLUDE_IN_EMAIL parameter has not been set up in DIR_PARAMETERS"
            Exit Sub
        End If
        
        sStage = strSQL
        
        '****************************************************************************************
        'INTERFACE REQUEST BUT YOU CAN CHANGE PARAM IN PARAMS TABLE SO THAT USER STILL GETS EMAIL
        '****************************************************************************************
        sStage = "check to see if it's interface"
        'MsgBox "rsDIR_INTERFACE_INDEX.EOF: " & rsDIR_INTERFACE_INDEX.EOF
        If rsDIR_INTERFACE_INDEX.EOF = False And rsDIR_INTERFACE_INDEX.BOF = False Then
            
            If sSendEmailToClient = "Y" And bOK = 1 Then
                'if the mail to the client is yes and the request is auto
                'Send Mail if the param says so, and its an auto response
                Set cJMail = New clsJMail
                
                cJMail.EMailServer = "mail.liberty.co.za"
                cJMail.MsgFrom = "info@keytax.co.za"
                cJMail.MSGFromName = "KeyTax: Tax Directives"
                cJMail.MSGSubject = adorsEMail.Fields("Taxpayer") & ": Directive requested on " & Format(adorsEMail.Fields("request_date"), "YYYYMMDD")
                cJMail.MSGBody = sEMailBody
                cJMail.AddRecipient adoRs.Fields("EMail_address"), adorsEMail.Fields("requested_by")
                strEmailAddress = adoRs.Fields("EMail_address") & " " & adorsEMail.Fields("requested_by")
                If sFileName <> "" Then
                  cJMail.AddAttachment sFileName
                End If
                    
                If Not cJMail.SendMSG Then
                    MsgBox "Error Sending Mail. Req Seq Num: " & adoRs.Fields("req_seq_num")
                    'adoConn.Execute "dir_insert_error '" & Date & "','" & "Error Sending Mail" & "','clsSendEMail',0"
                  Set adoConn = Nothing
                  Exit Sub
                End If
                
                'Dim sErrMsg As String
                
                
                If Len(Trim(sFileName)) = 0 Then
                    sRequestBodyFile = CreateTextFileFromBody(sEMailBody, adoRs.Fields("req_seq_num"))
                    If Len(Trim(sRequestBodyFile)) > 0 Then
                        sFileName = sRequestBodyFile
                    End If
                End If
                
                sStage = "committing document"
                
                If Len(Trim(sFileName)) > 0 Then
                    blCreateWorkItem = SaveCommitDetail(adoRs.Fields("req_seq_num"), sFileName, adoConn, strErrMsg)
                    sStage = "savecommitdetail: " & blCreateWorkItem
                    If Not blCreateWorkItem Then
                        'Report this error to Mindkey support team
                        sStage = "send error to mindkey"
                        sStage = "Error: " & strErrMsg
                        sStage = "Mindkey: " & objReg.QA_Team
                        
                        Call SendEmail(objReg.QA_Team, _
                                        "Info@mindkey.co.za", _
                                         "Keytax Interface Error", _
                                            strErrMsg, _
                                             "Keytax Emailer")
                        MsgBox "Error committing committing document: " & sErrMsg
                        Set adoConn = Nothing
                        Exit Sub
                    Else
                        'trash file
                        'Kill sRequestBodyFile
                    End If
                End If
                
                ''its an auto request and send to client is no but its in the list
                ''so send it to email work station
                ' Set cJMail = New clsJMail
                 
                ' cJMail.EMailServer = "mail.liberty.co.za"
                ' cJMail.MsgFrom = adoRs.Fields("req_seq_num") & "@keytax.co.za"
                ' cJMail.MSGFromName = "KeyTax: Tax Directives"
                ' cJMail.MSGSubject = adorsEMail.Fields("Taxpayer") & ": Directive requested on " & Format(adorsEMail.Fields("request_date"), "YYYYMMDD")
                ' cJMail.MSGBody = sEMailBody
                ' cJMail.AddRecipient sEmailWStnEmail, "Workflow"
                ' strEmailAddress = adoRs.Fields("EMail_address") & " " & adorsEMail.Fields("requested_by")
                ' If sFileName <> "" Then
                '   cJMail.AddAttachment sFileName
                ' End If
                     
                ' If Not cJMail.SendMSG Then
                '     MsgBox "Error Sending Mail. Req Seq Num: " & adoRs.Fields("req_seq_num")
                '     'adoConn.Execute "dir_insert_error '" & Date & "','" & "Error Sending Mail" & "','clsSendEMail',0"
                '   Set adoConn = Nothing
                '   Exit Sub
                ' End If
            Else
                '****************************************************************************************
                'INTERFACE REQUEST - SEND TO WORKFLOW
                '****************************************************************************************
                If bOK = 1 Then
                    
                    'MsgBox "Request number: " & adoRs.Fields("req_seq_num")
                    DoEvents
                    DoEvents
                    If Len(Trim(sFileName)) = 0 Then
                        sRequestBodyFile = CreateTextFileFromBody(sEMailBody, adoRs.Fields("req_seq_num"))
                        If Len(Trim(sRequestBodyFile)) > 0 Then
                            sFileName = sRequestBodyFile
                        End If
                    End If
                    
                    'MsgBox "sFileName: " & sFileName
                    DoEvents
                    DoEvents
                    sStage = "Commit Form B"
                    sStage = "sFileName: " & sFileName
                    If Len(Trim(sFileName)) > 0 Then
                        sStage = "call rendezvous..."
                        blCreateWorkItem = SaveCommitDetail(adoRs.Fields("req_seq_num"), sFileName, adoConn, strErrMsg)
                        sStage = "Rendezvous done..."
                        If Not blCreateWorkItem Then
                            'Report this error to Mindkey support team
                            sStage = "Send error email to mindkey..."
                            sStage = "strErrMsg: " & strErrMsg
                            Call SendEmail(objReg.QA_Team, _
                                            "Info@mindkey.co.za", _
                                             "Keytax Interface Error", _
                                                strErrMsg, _
                                                 "Keytax Emailer")
                            MsgBox "Error committing committing document: " & sErrMsg
                            Set adoConn = Nothing
                            Exit Sub
                        Else
                            sStage = "Rendezvous successful..."
                            If Dir(sRequestBodyFile) <> "" Then
                                'trash file
                                'Kill sRequestBodyFile
                            End If
                        End If
                    End If
                    sStage = "Get next email in the queue..."
                    ''its an auto request and send to client is no but its in the list
                    ''so send it to email work station
                    'Set cJMail = New clsJMail
                    
                    'cJMail.EMailServer = "mail.liberty.co.za"
                    'cJMail.MsgFrom = adoRs.Fields("req_seq_num") & "@keytax.co.za"
                    'cJMail.MSGFromName = "KeyTax: Tax Directives"
                    'cJMail.MSGSubject = adorsEMail.Fields("Taxpayer") & ": Directive requested on " & Format(adorsEMail.Fields("request_date"), "YYYYMMDD")
                    'cJMail.MSGBody = sEMailBody
                    'cJMail.AddRecipient sEmailWStnEmail, "Workflow"
                    'strEmailAddress = adoRs.Fields("EMail_address") & " " & adorsEMail.Fields("requested_by")
                    
                    'If sFileName <> "" Then
                    '  cJMail.AddAttachment sFileName
                    'End If
                        
                    'If Not cJMail.SendMSG Then
                    '    MsgBox "Error Sending Mail. Req Seq Num: " & adoRs.Fields("req_seq_num")
                    '    'adoConn.Execute "dir_insert_error '" & Date & "','" & "Error Sending Mail" & "','clsSendEMail',0"
                    '  Set adoConn = Nothing
                    '  Exit Sub
                    'End If
                Else
                    'if the request is auto but its not in the list of workflow processes
                    'send a normal mail
                    Set cJMail = New clsJMail
                    
                    cJMail.EMailServer = "mail.liberty.co.za"
                    cJMail.MsgFrom = "info@keytax.co.za"
                    cJMail.MSGFromName = "KeyTax: Tax Directives"
                    cJMail.MSGSubject = adorsEMail.Fields("Taxpayer") & ": Directive requested on " & Format(adorsEMail.Fields("request_date"), "YYYYMMDD")
                    cJMail.MSGBody = sEMailBody
                    cJMail.AddRecipient adoRs.Fields("EMail_address"), adorsEMail.Fields("requested_by")
                    strEmailAddress = adoRs.Fields("EMail_address") & " " & adorsEMail.Fields("requested_by")
                    
                    If sFileName <> "" Then
                      cJMail.AddAttachment sFileName
                    End If
                        
                    If Not cJMail.SendMSG Then
                        MsgBox "Error Sending Mail. Req Seq Num: " & adoRs.Fields("req_seq_num")
                        'adoConn.Execute "dir_insert_error '" & Date & "','" & "Error Sending Mail" & "','clsSendEMail',0"
                      Set adoConn = Nothing
                      Exit Sub
                    End If
                End If
            End If
        Else
'*******************************************************************
'NOT AN INTERFACE REQUEST - EMAIL TO USER
'*******************************************************************
            'Send Mail if its not an auto response
            iCounter = iCounter + 1
            Form2.List1.AddItem CStr(iCounter) & " - " & adorsEMail.Fields("Taxpayer") & ": Directive requested on " & Format(adorsEMail.Fields("request_date"), "YYYYMMDD")
            Form2.List1.ListIndex = iCounter - 1
            Form2.List1.Refresh
            
            Set cJMail = New clsJMail
            
            cJMail.EMailServer = "mail.liberty.co.za"
            cJMail.MsgFrom = "info@keytax.co.za"
            cJMail.MSGFromName = "KeyTax: Tax Directives"
            cJMail.MSGSubject = adorsEMail.Fields("Taxpayer") & ": Directive requested on " & Format(adorsEMail.Fields("request_date"), "YYYYMMDD")
            cJMail.MSGBody = sEMailBody
            cJMail.AddRecipient adoRs.Fields("EMail_address"), adorsEMail.Fields("requested_by")
            strEmailAddress = adoRs.Fields("EMail_address") & " " & adorsEMail.Fields("requested_by")
            
            If sFileName <> "" Then
              cJMail.AddAttachment sFileName
            End If
            
            If Not cJMail.SendMSG Then
                MsgBox "Error Sending Mail. Req Seq Num: " & adoRs.Fields("req_seq_num")
                Set adoConn = Nothing
                Exit Sub
            End If
'*******************************************************************
'EMAIL QA COPY OF EMAIL TO SHANE,RICHARD,TINA
'*******************************************************************
            'Send QA Copy
            If iCounter = 1 Then
                Set cJMail = New clsJMail
                cJMail.EMailServer = "mail.liberty.co.za"
                cJMail.MsgFrom = "info@keytax.co.za"
                cJMail.MSGFromName = "KeyTax Quality Assurance"
                cJMail.MSGSubject = adorsEMail.Fields("Taxpayer") & ": Directive requested on " & Format(adorsEMail.Fields("request_date"), "YYYYMMDD")
                cJMail.MSGBody = sEMailBody
                cJMail.AddRecipient "richard@mindkey.co.za", "Richard Knowles"
                'cJMail.AddRecipient "shane@mindkey.co.za", "Shane Smith"
                cJMail.AddRecipient "tina@mindkey.co.za", "Tina Vorster"
                cJMail.AddRecipient "Kevin@mindkey.co.za", "Kevin Ablett"
                cJMail.AddRecipient "brian@mindkey.co.za", "Brian Maswanganye"
                cJMail.AddRecipient "Mnooy@mindkey.co.za", "Mariek Nooy"
                If sFileName <> "" Then
                    cJMail.AddAttachment sFileName
                End If
                'send the email to the relevant recipient
                If Not cJMail.SendMSG Then
                    MsgBox "Error Sending Mail. Req Seq Num: " & adoRs.Fields("req_seq_num")
                    Set adoConn = Nothing
                    Exit Sub
                End If
            End If
        End If
    Else
        'send the email to the normal recipient
'*******************************************************************
'NOT AN INTERFACE REQUEST - EMAIL TO USER
'*******************************************************************
        iCounter = iCounter + 1
        Form2.List1.AddItem CStr(iCounter) & " - " & adorsEMail.Fields("Taxpayer") & ": Directive requested on " & Format(adorsEMail.Fields("request_date"), "YYYYMMDD")
        Form2.List1.ListIndex = iCounter - 1
        Form2.List1.Refresh
        
        Set cJMail = New clsJMail
            
        cJMail.EMailServer = "mail.liberty.co.za"
        cJMail.MsgFrom = "info@keytax.co.za"
        cJMail.MSGFromName = "KeyTax: Tax Directives"
        cJMail.MSGSubject = adorsEMail.Fields("Taxpayer") & ": Directive requested on " & Format(adorsEMail.Fields("request_date"), "YYYYMMDD")
        cJMail.MSGBody = sEMailBody
        cJMail.AddRecipient adoRs.Fields("EMail_address"), adorsEMail.Fields("requested_by")
        strEmailAddress = adoRs.Fields("EMail_address") & " " & adorsEMail.Fields("requested_by")
        
        If sFileName <> "" Then
          cJMail.AddAttachment sFileName
        End If
            
        If Not cJMail.SendMSG Then
            MsgBox "Error Sending Mail. Req Seq Num: " & adoRs.Fields("req_seq_num")
          Set adoConn = Nothing
          Exit Sub
        End If
'*******************************************************************
'EMAIL QA COPY OF EMAIL TO SHANE,RICHARD,TINA
'*******************************************************************
        'Send QA Copy
        If iCounter = 1 Then
            Set cJMail = New clsJMail
            cJMail.EMailServer = "mail.liberty.co.za"
            cJMail.MsgFrom = "info@keytax.co.za"
            cJMail.MSGFromName = "KeyTax Quality Assurance"
            cJMail.MSGSubject = adorsEMail.Fields("Taxpayer") & ": Directive requested on " & Format(adorsEMail.Fields("request_date"), "YYYYMMDD")
            cJMail.MSGBody = sEMailBody
            cJMail.AddRecipient "richard@mindkey.co.za", "Richard Knowles"
            cJMail.AddRecipient "mnooy@mindkey.co.za", "Mariek Nooy"
            cJMail.AddRecipient "tina@mindkey.co.za", "Tina Vorster"
            cJMail.AddRecipient "kevin@mindkey.co.za", "Kevin Ablett"
            cJMail.AddRecipient "brian@mindkey.co.za", "Brian Maswanganye"
            If sFileName <> "" Then
                cJMail.AddAttachment sFileName
            End If
            'send the email to the relevant recipient
            If Not cJMail.SendMSG Then
                MsgBox "Error Sending Mail. Req Seq Num: " & adoRs.Fields("req_seq_num")
                Set adoConn = Nothing
                Exit Sub
            End If
        End If
    End If
    '************************************************************************
    '****       END ANTHONY PATTONS CHANGES
    '************************************************************************
'Change email status to 'Y'
sStage = "Flagging as EMailed " & adoRs.Fields("req_seq_num")
adoConn.Execute "Dir_Update_Emailed_YN " & adoRs.Fields("req_seq_num") & ", 'Y'" 'mark as EMailed
                
adorsEMail.Close
adoRs.MoveNext 'move to next Directive to process

Wend 'no more directives to process

Set cJMail = Nothing

'Clean Up
crFormC.DiscardSavedData 'clear out report data
'release Recordset of all EMailing Details
Set adorsEMail = Nothing
'release Recordset of all Pending Directives
adoRs.Close
Set adoRs = Nothing
'close and release connection to SQL Server
adoConn.Close
Set adoConn = Nothing

'Shane: Only for the purpose of testing
sPDFPath = "C:\"
Set objReg = Nothing
If Dir(sPDFPath & "*.pdf") <> "" Then
   Kill sPDFPath & "*.pdf"
End If


If Dir(sPDFPath & "*.txt") <> "" Then
   Kill sPDFPath & "*.txt"
End If

'MsgBox "Complete"
Unload Form2

Exit Sub

Send_FormC_Error:

If Err <> 13 And Err <> 94 Then
  sStage = sStage & " " & Err.Description
  While InStr(sStage, "'") > 0
    sStage = Left(sStage, InStr(sStage, "'") - 1) & "`" & Mid$(sStage, InStr(sStage, "'") + 1)
  Wend
  'adoConn.Execute "dir_insert_error '" & Date & "','" & sStage & "','clsDirSendFormC'," & Err.Number
  MsgBox Err.Number & Err.Description & vbCrLf & Chr(13) & sStage
  Set adoConn = Nothing
  Exit Sub
End If

Resume Next

End Sub

Private Sub SendErrorEmail(lngReqSeqNum As Long, strErrMsg As String)

    Set cJMail = New clsJMail
    cJMail.EMailServer = "mail.liberty.co.za"
    cJMail.MsgFrom = "email@keytax.co.za"
    cJMail.MSGFromName = "Email Automation"
    cJMail.MSGSubject = "Email Error"
    cJMail.MSGBody = strErrMsg
    cJMail.AddRecipient "mnooy@mindkey.co.za", "Mariek Nooy"
    cJMail.AddRecipient "tina@mindkey.co.za", "Tina Vorster"
    cJMail.AddRecipient "Kevin@mindkey.co.za", "Kevin Ablett"
    cJMail.AddRecipient "Brian@mindkey.co.za", "Brian Maswanganye"
    If Not cJMail.SendMSG Then
        MsgBox "Unbale to send error email for ReqSeqNum: " & lngReqSeqNum
        Exit Sub
    End If

End Sub
Public Function IsAppRunning() As Boolean
    Dim blnResult As Boolean
    Dim strOldTitle As String

    'is the application already loaded?
    'if so then restore the previous instance of the prog
    'by making it active and bringing it to the top

    If App.PrevInstance Then
        'change the new instance title to prevent it from being located instead of the original
        strOldTitle = App.Title
        App.Title = App.Title & "...Duplicate"
        RestorePreviousInstance strOldTitle
        App.Title = strOldTitle

        blnResult = True
    Else
        blnResult = False
    End If

    IsAppRunning = blnResult

End Function


Private Sub RestorePreviousInstance(ByVal strPreviousTitle As String)
    Dim hPrevWin As Long
    Dim lngRetVal As Long
    Dim apiWindowPlacement As TWINDOWPLACEMENT

    'using the class name for the compiled exe class
    'prevents the routine from finding and attempting to
    'activate the project form of the same name

    hPrevWin = FindWindow(VB5_CLASS_NAME, strPreviousTitle)

      DoEvents

      If hPrevWin > 0 Then
        ' Get the current window state of the previous instance
        apiWindowPlacement.lngLength = Len(apiWindowPlacement)
        lngRetVal = GetWindowPlacement(hPrevWin, apiWindowPlacement)

        ' If the ShowCmd member indicates that the window
        ' is currently minimized, it needs to be restored, so...
        If apiWindowPlacement.lngShowCmd = SW_SHOWMINIMIZED Then
          apiWindowPlacement.lngShowCmd = Len(apiWindowPlacement)
          apiWindowPlacement.lngFlags = 0&
          apiWindowPlacement.lngShowCmd = SW_SHOWNORMAL
          lngRetVal = SetWindowPlacement(hPrevWin, apiWindowPlacement)
        End If

        ' Bring the window to the front and make it the active
        ' window.  Without this, it may remain behind other windows
        lngRetVal = SetForegroundWindow(hPrevWin)

        DoEvents

      End If

End Sub

'Author      : Sibusiso Maswanganye
'Function    : Rendezvous Keytax directive with case on workflow or create case send to END Q
'Return Value: True [Successful] * False [UnSuccessful]
'Params      : ReqSeqNum        - Keytax Request Number
'            : KeytaxAttachment - Attached directive that was supposed to be sent to emailkst in PDF format
'            : DBConnection     - Current DB Connection from email program
'            : ErrorMessage     - Error message that might be returned when error while trying to rendezvous document
Public Function SaveCommitDetail(ReqSeqNum As String, KeytaxAttachment As String, DBConnection As ADODB.Connection, Optional ErrorMessage As String = "") As Boolean

    Dim strSQL As String
    Dim rsRecordSet As ADODB.Recordset
    Dim strSysCode As String
    Dim strQueueCode As String
    Dim strDocClass As String

    Dim lngRecordsAffected As Long
    Dim strXmlTiffPath As String
    Dim colTiffFileNames As Collection

    Dim strTifs As String
    Dim lngFnetDocID As Long
    Dim lngDocCount As Long
    Dim rsTemp As ADODB.Recordset
    Dim lngErr As Long
    Dim rsOldPolicyInfo As ADODB.Recordset
    Dim strLQH As String
    Dim i As Integer
    Dim lngAnswer As Long
    Dim strIndexType As String
    Dim sSourceId As String
    Dim strPFile As String
    Dim strFirstTifDate As String
    Dim lSourceAuditId As Long
    Dim lCounter As Long
    
    'audit holder vars
    Dim sType As String
    Dim dDate As Date
    Dim lPageCount As Long
    Dim sPFile As String
    Dim sMachineID As String
    Dim sScannerName As String
    Dim sMasterTable As String
    Dim arrFreeText() As String
    Dim rsAudit As ADODB.Recordset
    Dim objMssImageLink As Object
    Dim DualCommitImageStoreDesc As String
    
    Dim DefaultImageStoreCD As String
    Dim sMVAR_TextPath As String
    Dim bSaveToSourceAudit As Boolean
    Dim sErrorMessage As String
    Dim sProcessFilename As String
    Dim ErrorMsg As String
    
    On Error GoTo SaveCommitDetailFix
    
    'Load XML file on app.path
    Call oXMLDocument.Load(App.Path & "\KeytaxEmail.xml")
    
    'Get settings
    sBusinessUnit = oXMLDocument.getElementsByTagName("BusinessUnit").Item(0).Text
    strUserId = oXMLDocument.getElementsByTagName("UserName").Item(0).Text
    strPassword = DecryptWithALP(CStr(oXMLDocument.getElementsByTagName("Password").Item(0).Text))
    sMVAR_TextPath = oXMLDocument.getElementsByTagName("TextPath").Item(0).Text
    sMachineID = oXMLDocument.getElementsByTagName("Machine_Id").Item(0).Text
    OracleConnectionString = DecryptWithALP(CStr(oXMLDocument.getElementsByTagName("ORACLECONNECT").Item(0).Text))
    SQLConnectionString = DecryptWithALP(CStr(oXMLDocument.getElementsByTagName("SQLCONNECT").Item(0).Text))
    sBusinessUnitName = oXMLDocument.getElementsByTagName("BusinessUnitName").Item(0).Text
    
    On Error Resume Next
    'Close previous MS SQL server db connection and connect to oracle
    modGeneral.DBConnection.CommitTrans
    modGeneral.DBConnection.Close
    On Error GoTo SaveCommitDetailFix
    
    
    'Connect to database
    'If Not modGeneral.DBConnect("", OracleConnectionString) Then
    If Not modGeneral.DBConnect("", "") Then
        SaveCommitDetail = False
        ErrorMessage = "Unable to connect to the Workflow database"
        Exit Function
        'Err.Raise vbObjectError, "modGeneral.SaveCommitDetails", "Unable to connect to the Workflow database"
    End If
    
    'Create SourceAudit Filename(SOURCE_FILE)
    'sProcessFilename = GetProcessFilename(sMachineID, sMVAR_TextPath)
    
    'Generate GUID as file
    sProcessFilename = GetGuid
    
    If Len(sProcessFilename) > 0 Then
        'Insert this record to SourceAudit
        bSaveToSourceAudit = SaveToSourceAudit(lSourceAuditId, sErrorMessage, sProcessFilename, sBusinessUnit, 1, sMachineID)
    End If
    
    If bSaveToSourceAudit And lSourceAuditId > 0 Then
        'Get the source details of this request
        sSourceId = modGeneral.GetWorkSourceDetails(ReqSeqNum, sMachineID)
        
        'if the source lookup failed, raise an error
        If sSourceId = "" Then
            ErrorMessage = "Source ID retrieval failed"
            SaveCommitDetail = False
            'Err.Raise vbObjectError, "clsLogger.SaveCommitDetsail", "GetWorksourceDetails Failed."
            Exit Function
        End If
        
        ' Get xml variables [default path where directive files are created in keytax email app]
        strXmlTiffPath = "C:\"
        lngDocCount = CLng(1)
        
        'ADD TIFF PATH AND FILENAME INTO ONE STRING TO BE SENT/COMMITTED TO FILENET
        
        strTifs = KeytaxAttachment
        
        'Sourece Audit lookup (GUID)
        sPFile = sProcessFilename
        
        'sPFile = GetFilenameWithoutExtention(sPFile)
        
        'strSQL = "select source_audit_id from mss_source_audit where upper(source_file) like '%" & UCase(sPFile) & "'"
        strSQL = "select source_audit_id from mss_source_audit where source_file = '" & UCase(sPFile) & "'"
        Set rsAudit = modGeneral.DBConnection.Execute(strSQL)
        If rsAudit.BOF = True And rsAudit.EOF = True Then
            'the source audit record was not found using filename now attempt exact-match filename search
            strSQL = "select source_audit_id from mss_source_audit where source_file ='" & UCase(sPFile) & "'"
            Set rsAudit = modGeneral.DBConnection.Execute(strSQL)
            
            If rsAudit.BOF = True And rsAudit.EOF = True Then
                ErrorMessage = "SourceAudit record could not be retrieved: " & UCase(sPFile)
                SaveCommitDetail = False
                Exit Function
                'the file will be read only so change the files attributes to allow us to delete it
                'Err.Raise AutoErrors.SOURCE_AUDIT_FAILED, "AutoLogger.clsLogger.SaveCommitDetail", "No source audit record for pfile " & sPFile & ". Control File Quarantined in the Error Folder."
            End If
        End If
        
        rsAudit.MoveFirst
        lSourceAuditId = rsAudit!source_audit_id
        
        If Len(Trim(strTifs)) > 0 Then
            'Create object for committing images to image store if there any to commit
            Set objImageLibrary = CreateObject("MSSImageLink.clsMSSImageLink")
        
            If ImageLibraryLogon Then
                lngErr = CommitDocuments(sSourceId, strTifs, lngFnetDocID, modGeneral.DBConnection)
                If lngErr <> 0 Or lngFnetDocID = 0 Then
                    SaveCommitDetail = False
                    ErrorMessage = objImageLibrary.MSS_ErrorMessage(lngErr)
                    Exit Function
                End If
            Else
                SaveCommitDetail = False
                ErrorMessage = "Logon to image library failed."
            End If
        End If
            
        sMasterTable = modGeneral.GetSourceMasterTable(sSourceId)
        
        '************************** Create Work for the differant clients and also storage libraries *************************
        If Not HandleCreateWork(sMasterTable, lngFnetDocID, sSourceId, lngDocCount, lSourceAuditId, ReqSeqNum, sImageStoreCD, ErrorMsg) Then
            ErrorMessage = "Rendezvous/Create work failed : " & ErrorMsg
            SaveCommitDetail = False
            'Err.Raise AutoErrors.SOURCE_AUDIT_FAILED, "AutoLogger.clsLogger.SaveCommitDetail", "HandleCreateWork failed for master table: " & sMasterTable
        End If
        '****************************************************************************************************
        
        SaveCommitDetail = True
    Else
        ErrorMessage = "Source Audit Record could not be created."
        SaveCommitDetail = False
        Exit Function
    End If

    Exit Function

SaveCommitDetailFix:
    ErrorMessage = Error & "[" & Err & "]"
    SaveCommitDetail = False
    Open App.Path & "\SaveCommitdetail.log" For Output As #1
        Print #1, Error
    Close #1
    Exit Function
    Resume Next
End Function

Public Function AuditRequest(lSourceAuditId As Long) As Boolean
    Dim objSourceAudit As Object
    
    On Error GoTo errhandler:
    Set objSourceAudit = CreateObject("SourceAudit.clsAudit")
        objSourceAudit.ConnectionString = modGeneral.DBConnection.Connection
        
        AuditRequest = objSourceAudit.Audit(lSourceAuditId, sBusinessUnit)
    Exit Function
errhandler:
    Exit Function
    Resume Next
End Function

Private Function HandleCreateWork(ByVal sMasterTable As String, _
                                ByVal lngFnetDocID As Long, _
                                ByVal sSourceId As String, _
                                ByVal lngDocCount As Long, _
                                ByVal lSourceAuditId As Long, _
                                Optional ByVal ReqSeqNum As String, _
                                Optional ByVal sImageStoreCD As String, _
                                Optional ByRef sErrMsg As String = "") As Boolean

    On Error GoTo PROC_ERROR
    'THIS FUNCTION WILL HANDLE THE SELECT CASE FOR EACH OF THE SEPERATE CLIENTS
    'THAT WILL BE CALLING DIFFERANT CREATE WORK FUNCTIONS BECAUSE THE MASTER TABLES
    'DIFFER
    Dim objWorkObject As Object
    Dim objCharter As Object
    Dim objHealthcare As Object
    Dim sDestQueue As String
    Dim sComment As String
    Dim sEntityNum As String
    
    Dim CONTRACT_NO As Integer
    Dim SYSTEM As Integer
    
    Dim objLCB As Object
    Dim sSchemeNo As String
    Dim sMemberNo As String
    Dim sSurname As String
    Dim sInitals As String
    Dim sIDNum As String
    Dim sSchemeName As String
    Dim oMKC As Object
    Dim objLPB As Object
    
    Dim dValue As Double
    
    Dim UserLogin As String
    Dim UserPassword As String
    
    'pass ctrl back to os to process waiting messages
    'DoEvents
    
    CONTRACT_NO = 0
    SYSTEM = 1
    
    Select Case sMasterTable
        Case "LCB_MASTER"
            Set objLCB = CreateObject("LCBWorkflow.clsWorkObject")
            'Set oMKC = CreateObject("MKConnect.clsConnect")
            
            'Set objLCB = New clsWorkObject
            'objLCB.ConnectionString = oMKC.ConnectString
            objLCB.ConnectionString = OracleConnectionString
             
            'lookup data from keytax
            Call modGeneral.GetKeytaxIndexInfo(ReqSeqNum, _
                                               sMemberNo)
SubContinue:
            Call modGeneral.GetSchemeAndMemberInfo(sSchemeNo, _
                                                    sMemberNo, _
                                                    sSchemeName, _
                                                    sSurname, _
                                                    sInitals, _
                                                    sIDNum)
            'auto index required
            If Not objLCB.CreateWorkItem(lngFnetDocID, _
                                        "EMAIL", _
                                        "SYSTEM", _
                                        sSourceId, _
                                        sSchemeNo, _
                                        sSchemeName, _
                                        sMemberNo, _
                                        sSurname, _
                                        sInitals, _
                                        sIDNum, _
                                        "SYSTEM", _
                                        lngDocCount, _
                                        lSourceAuditId, _
                                        "2") Then
                                                                        
                'SYSTEM is the user under which the auto logger will create work, this
                'user will not rendfezvous work. Otherwise all work created by the
                'autologger will be rendezvoused into the same case. which is undesirable.
                                                               
                'Err.Raise AutoErrors.CREATE_WORK_OBJECT_FAILED, "AutoLogger.clsLogger.SaveCommitDetail - LCB CreateWork"
                HandleCreateWork = False
                Exit Function
            End If
            Set objLCB = Nothing
    End Select
    
    Set objWorkObject = Nothing
    HandleCreateWork = True
    
    Exit Function
PROC_ERROR:
    If Err = -2147467259 Then
        GoTo SubContinue:
    End If
    Set objWorkObject = Nothing
    HandleCreateWork = False
    sErrMsg = Error & "[" & Err & "]"
    'HandleError Err, "AutoLogger.clsLogger.HandleCreateWork"
    Exit Function
    Resume Next
End Function

'*-----------------------------------------------------------------
'* Method:      GetProcessFilename
'* Description: Generate a unique filename that will hold the
'*              processed information for this scan session
'* Parameters:  None
'* Returns:     String - The unique process filename
'*-----------------------------------------------------------------
Private Function GetProcessFilename(sStatioName As String, ASCIIFolder As String) As String
    Dim strFileName As String
    Dim strFileFolder As String
    Dim strFilePrefix As String
    Dim strFileSuffix As String
    Dim dtDate As Date
    
    On Error GoTo errhandler:
    
    dtDate = Now()
  
      ' Get the default file values
  
    strFileFolder = ASCIIFolder
    
    strFilePrefix = Format$(dtDate, "yyyymmddHhNnSs") & "_" & sStatioName
    strFileSuffix = "TXT"
  
  
    strFileName = GetTemporaryFilename(strFileFolder, strFilePrefix, strFileSuffix)
  
    GetProcessFilename = strFileName
    Exit Function
errhandler:
    Exit Function
    Resume Next
End Function

Private Function CommitDocuments(ByVal nSourceID As Long, StrFiles As String, lFnetDocId As Long, DBConn As ADODB.Connection) As Long
    
    Dim lngErr As Long
    
    On Error GoTo errhandler:
    
    
    lngErr = objImageLibrary.MSS_Commit(nSourceID, StrFiles, sBusinessUnit, lFnetDocId, sDefaultImageStoreCd)
    Debug.Print lFnetDocId
    
    'lngErr = objImageLibrary.MSS_Commit("LCBDocs", StrFiles, lFnetDocId)
    If lngErr <> 0 Or lFnetDocId = 0 Then
        CommitDocuments = lngErr
        'MsgBox "Images could not be committed to " & Trim(AdoRs("IMAGE_STORE_DESC")) & " Library.Please contact system administrator", vbExclamation + vbOKOnly
        'MsgBox "Images could not be committed to filenet Library.Please contact system administrator", vbExclamation + vbOKOnly
    End If
    Exit Function
errhandler:
    
    CommitDocuments = Err
    Exit Function
    Resume Next
End Function

'Method to create a text file
Private Function CreateTextFileFromBody(sBodyText As String, RequestNo As String) As String
    Dim sFileName As String
    
    On Error GoTo errhandler:
    
    sFileName = "c:\" & RequestNo & ".txt"
    Open sFileName For Output As #3
        Print #3, sBodyText
    Close #3
    CreateTextFileFromBody = sFileName
    Exit Function
errhandler:
    CreateTextFileFromBody = ""
    Exit Function
    Resume Next
End Function
